home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / magnify2.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-25  |  6KB  |  290 lines
  1. program magnify;
  2. {
  3.     Magnify #2
  4.     ... now: on a tweak-vga screen with a larger glass!
  5.     - by Bjarke Viksφe
  6.     mar 1994
  7.  
  8.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  9.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  10.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  11.  
  12.     This time true DPMI. No more self-modifying cheating.
  13.     It looks allright - and takes only half a screen on my machine, but
  14.     doing 7414 plots in a row... pheew!
  15.     The formula is still not quite right. It's only bending the pix around
  16.     the glass... but who cares?
  17.  
  18.     How does it work. Well, a simple math.formula bends pixels from a
  19.     square and puts the result in an array.
  20.     So we tranverse the square from (x1,y1) to (x2,y1) through (x2,y2).
  21.     We put our x/y values through the math.formula and the resulting
  22.     coords are used as index to store the address-offset that our square
  23.     x/y point to.
  24.     We could now go through the array. If the index has a value then
  25.     we use the value as an offset into our graphics. We then get the
  26.     colour value and plot the pixel. Else if the index has no value simply
  27.     skip plotting any pixel at this point.
  28.  
  29.     But the big array is compacted so that no non-value indexes are
  30.     left. A lot quicker. And the again we split the new
  31.     array into 4 arrays to speed things up when writing to the tweaked-screen.
  32. }
  33.  
  34. uses
  35.     DEMOINIT,ILBM256;
  36.  
  37. const
  38.     DEBUG = FALSE;
  39.     MAX = 48;
  40.  
  41. type
  42.     pPosBuffer = ^PosBufferType;
  43.     PosBufferType = array[0..1500*2] of word;
  44.  
  45. var
  46.     stackseg,stackptr : word;
  47.  
  48.     oldx,oldy : integer;
  49.  
  50.     xpos, ypos, xadd, yadd : word;
  51.     xpostabel : array [0..511] of integer;
  52.     ypostabel : array [0..511] of integer;
  53.  
  54.     posbuffer: array[0..3] of pPosBuffer;
  55.     posantal : array[0..3] of integer;
  56.     ztabel : array [0..MAX*2] of integer;
  57.  
  58.     screen,tempscreen : pScreen;
  59.  
  60. const
  61.     display1 : integer = $0000;
  62.     display2 : integer = $4000;
  63.  
  64. (*------------------------------------------------*)
  65.  
  66.  
  67.  
  68. procedure SetupSinus;
  69. var
  70.     i : integer;
  71.     v, vadd : real;
  72. begin
  73.     v:=0.0;
  74.     vadd:=(2.0*pi/512.0);
  75.     for i:=0 to 511 do begin
  76.         xpostabel[i]:=round(sin(v)*110)+160;
  77.         v:=v+vadd;
  78.     end;
  79.     v:=0.0;
  80.     vadd:=(2.0*pi/512.0);
  81.     for i:=0 to 511 do begin
  82.         ypostabel[i]:=round(sin(v)*50)+100;
  83.         v:=v+vadd;
  84.     end;
  85.  
  86.     v:=pi/2.0;
  87.     vadd:=(pi/2.0)/(MAX*2.0);
  88.     for i:=0 to MAX*2 do begin
  89.         ztabel[i]:=round(sin(v)*2500);
  90.         v:=v+vadd;
  91.     end;
  92. end;
  93.  
  94.  
  95. procedure CalcMatrix;
  96. type
  97.     matrice = array[-MAX..MAX-1, -MAX..MAX-1] of word;
  98. var
  99.     i,j : integer;
  100.     x,y,z : longint;
  101.     tx,ty : longint;
  102.     matrix : ^matrice;
  103. begin
  104.     New(matrix);
  105.     FillChar(matrix^,SIZEOF(matrice),0);
  106.  
  107.     for y:=-MAX to MAX-1 do
  108.         for x:=-MAX to MAX-1 do begin
  109.             z := round(sqrt(sqr(x)+sqr(y)));
  110.             z := ztabel[z];
  111.             tx := (x*z) DIV 2170;    {... use different values because of}
  112.             ty := (y*z) DIV 2300;    {different scaling of x/y axis}
  113.             { the next if-sentence is to handle that strange bend when data
  114.               is put into buffer in wrong order? }
  115.             if (tx=x) AND (ty=y) then continue;
  116.             if (y<=0) then matrix^[tx,ty] := longmul(y,320)+(x)
  117.             else if (matrix^[tx,ty]=0) then matrix^[tx,ty] := longmul(y,320)+(x);
  118.         end;
  119.  
  120.     posantal[0]:=0;
  121.     posantal[1]:=0;
  122.     posantal[2]:=0;
  123.     posantal[3]:=0;
  124.  
  125.     for y:=-MAX to MAX-1 do
  126.         for x:=-MAX to MAX-1 do
  127.             if (matrix^[x,y]<>0) then begin
  128.                 j:=x AND 3;
  129.                 i:=posantal[j];
  130.                 posbuffer[j]^[i]:=longmul(y,WIDTH)+(x shr 2);
  131.                 posbuffer[j]^[i+1]:=matrix^[x,y];
  132.                 inc(posantal[j],2);
  133.             end;
  134.  
  135.     Dispose(matrix);
  136. end;
  137.  
  138. procedure InitDemo;
  139. var
  140.     i : integer;
  141. begin
  142.     FadeCMAP(0);
  143.     ClearWholeScreen;
  144.     SetupSinus;
  145.     for i:=0 to 3 do new(posbuffer[i]);
  146.     CalcMatrix;
  147.  
  148.     xpos :=40; ypos:=20;
  149.     oldx:=160; oldy:=100;
  150.     xadd :=2; yadd:=1;
  151.  
  152.     New(screen);
  153.     New(tempscreen);
  154.     LoadPix(screen,'parasit1.lbm');
  155.     MakeTweak(screen,tempscreen);
  156.     Copy2TweakScreen(tempscreen,Ptr(SEGA000,display1));
  157.     Copy2TweakScreen(tempscreen,Ptr(SEGA000,display2));
  158.     for i:=0 to 64 do FadeCMAP(i*4);
  159. end;
  160.  
  161. procedure UninitDemo;
  162. var
  163.     i : integer;
  164. begin
  165.     for i:=0 to 3 do Dispose(posbuffer[i]);
  166.     Dispose(screen);
  167.     Dispose(tempscreen);
  168. end;
  169.  
  170. (*------------------------------------------------*)
  171.  
  172. procedure SwapDisplay;
  173. var
  174.     temp : word;
  175. begin
  176.     temp:=display2;
  177.     display2:=display1;
  178.     display1:=temp;
  179.     SetAddress(Ptr(SEGA000,display2));
  180. end;
  181.  
  182. (*------------------------------------------------*)
  183.  
  184. procedure CopyFromBuffer(x,y : integer);
  185. var
  186.     i : integer;
  187.     source_offset, dest_offset : word;
  188. begin
  189.     dec(x,MAX);
  190.     dec(y,MAX);
  191.     source_offset:=longmul(y,WIDTH)+((x shr 3) shl 1);
  192.     dest_offset:=source_offset;
  193.     for i:=0 to 3 do begin
  194.         SetBitplanes(1 shl i);
  195.         asm
  196.             push    ds
  197.             mov    es,SEGA000
  198.             mov    di,display1
  199.             lds    si,tempscreen
  200.             add    si,source_offset
  201.             add    di,dest_offset
  202.             mov    bx,WIDTH-(MAX/2)
  203.             mov    cx,MAX*2
  204.             cld
  205. @yloop:  mov    dx,cx
  206.             mov    cx,MAX/8
  207.             DB $F3,$66,$A5    {rep stosd}
  208.             add    si,bx
  209.             add    di,bx
  210.             mov    cx,dx
  211.             loop    @yloop
  212.             pop    ds
  213.         end;
  214.         inc(source_offset,80*200);
  215.     end;
  216. end;
  217.  
  218.  
  219. procedure PrintMagnifyGlass(src_offset, dst_offset : integer; p : pPosBuffer;
  220.                                     antal : integer); assembler;
  221. asm
  222.     mov    stackptr,bp
  223.     mov    es,SEGA000
  224.     mov    ax,WORD PTR screen+2
  225.     mov    dx,src_offset
  226.     lds    si,p
  227.     mov    cx,antal
  228.     mov    bp,dst_offset
  229.     shr    cx,1
  230.     DB $8E,$E0        {mov fs,ax}
  231.     cld
  232. @loop:
  233.     lodsw
  234.     add    ax,bp
  235.     mov    di,ax
  236.     lodsw
  237.     add    ax,dx
  238.     mov    bx,ax
  239.     DB $64            {FS: prefix}
  240.     mov    al,[bx]
  241.     mov    [es:di],al
  242.     loop    @loop
  243.     mov    ax,SEG @DATA
  244.     mov    ds,ax
  245.     mov    bp,stackptr
  246. end;
  247.  
  248. (*------------------------------------------------*)
  249.  
  250.  
  251. procedure RunOnce;
  252. var
  253.     i : integer;
  254.     x,y : integer;
  255.     src_offs, dst_offs : integer;
  256. begin
  257.     SwapDisplay;
  258.     VBLANK;
  259.     if DEBUG then SetRGB(0,30,0,0);
  260.  
  261.     CopyFromBuffer(oldx,oldy);
  262.     x := xpostabel[xpos AND 511];
  263.     y := ypostabel[ypos AND 511];
  264.     src_offs:=longmul(y,320)+x;
  265.     dst_offs:=(longmul(y,WIDTH)+(x shr 2))+display1;
  266.     for i:=0 to 3 do begin
  267.         SetBitplanes(1 shl (x AND 3));
  268.         PrintMagnifyGlass(src_offs,dst_offs, posbuffer[i],posantal[i]);
  269.         if ((x AND 3) = 3) then inc(dst_offs);
  270.         inc(x);
  271.     end;
  272.  
  273.     oldx:=x; oldy:=y;
  274.     inc(xpos,xadd);
  275.     inc(ypos,yadd);
  276.  
  277.     if DEBUG then SetRGB(0,0,0,0);
  278. end;
  279.  
  280.  
  281. begin
  282.     OpenScreen;
  283.     Screen_Off;
  284.     InitDemo;
  285.     Screen_On;
  286.     repeat RunOnce until KeyPressed;
  287.     UninitDemo;
  288.     CloseScreen;
  289. end.
  290.